(*
  * Copyright (c) 2012 by Kenjiro Fukumitsu, All rights reserved.
  *
  * Use of the source code and binary libraries included in this package
  * is permitted under the following terms:
  *
  * Redistribution and use in source and binary forms, with or without
  * modification, are permitted provided that the following conditions
  * are met:
  *
  * 1. Redistributions of source code must retain the above copyright
  *    notice, this list of conditions and the following disclaimer.
  * 2. Redistributions in binary form must reproduce the above copyright
  *    notice, this list of conditions and the following disclaimer in the
  *    documentation and/or other materials provided with the distribution.
  *
  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
  * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

unit JSONLibraryUnit;

interface

uses
  Classes, SysUtils, Generics.Collections, Math, StrUtils;

type

  EJsonParseError = class(Exception)
  end;

  TJSONValueType = (jvtBool, jvtNull, jvtObject, jvtArray, jvtNumber,
    jvtString);

  TJSONValueTypes = set of TJSONValueType;

  TJSONCreateTextOption = class
  private
    FEscapeUnicodeChar: Boolean;
    FIndentString: string;
    FLineBreak: string;
    FEscapeSlash: Boolean;
    FNoIndent: Boolean;
    FNoLineBreak: Boolean;
    FPackedArray: Boolean;
    FPackedObject: Boolean;
    FSpaceAfterNameSeparator: Boolean;
    FSpaceAfterValueSeparator: Boolean;
    FLineLengthThreshold: Integer;
  public
    property EscapeUnicodeChar: Boolean read FEscapeUnicodeChar
      write FEscapeUnicodeChar;
    // In RFC 4627, slash exists in "unescaped" group also
    property EscapeSlash: Boolean read FEscapeSlash write FEscapeSlash;
    property IndentString: string read FIndentString write FIndentString;
    property LineBreak: string read FLineBreak write FLineBreak;
    property NoIndent: Boolean read FNoIndent write FNoIndent;
    property NoLineBreak: Boolean read FNoLineBreak write FNoLineBreak;
    property PackedArray: Boolean read FPackedArray write FPackedArray;
    property PackedObject: Boolean read FPackedObject write FPackedObject;
    property SpaceAfterNameSeparator: Boolean read FSpaceAfterNameSeparator
      write FSpaceAfterNameSeparator;
    property SpaceAfterValueSeparator: Boolean read FSpaceAfterValueSeparator
      write FSpaceAfterValueSeparator;
    property LineLengthThreshold: Integer read FLineLengthThreshold
      write FLineLengthThreshold;
    constructor Create;
  end;

  TJSONTextBuilder = class
  private
    FOption: TJSONCreateTextOption;
    FNewLine: Boolean;
    FLineLength: Integer;
    FBuffer: string;
    FCapacity: Integer;
    FSize: Integer;
    FIndent: Integer;

    procedure PrepareWrite( NoAutoLineBreak: Boolean = False );
    procedure InternalWriteBuffer(const buf; len: Integer); inline;
    procedure InternalWrite(const S: string); overload; inline;
    procedure InternalWrite(const ch: Char); overload; inline;
  public
    procedure Write(const S: string; NoAutoLineBreak: Boolean = False); overload; inline;
    procedure Write( ch: Char; NoAutoLineBreak: Boolean = False); overload; inline;
    procedure WriteJSONString( const S: string);
    procedure WriteLineBreak; inline;
    procedure WriteNameSeparator; inline;
    procedure WriteValueSeparator; inline;
    function GetText: string;

    procedure IncrIndent; inline;
    procedure DecrIndent; inline;
    property Indent: Integer read FIndent;

    constructor Create(AOption: TJSONCreateTextOption;
      AStartIndent: Integer = 0);
  end;

  TJSONParseContext = class;

  IJSONValue = interface;
  IJSONObject = interface;
  IJSONArray = interface;
  IJSONString = interface;
  IJSONNumber = interface;
  IJSONBool = interface;
  IJSONNull = interface;

  IJSONValue = interface
    ['{69CCB9A4-5F85-44A3-8599-2415BA08DD43}']
    function IsObject: Boolean;
    function IsArray: Boolean;
    function IsString: Boolean;
    function IsNumber: Boolean;
    function IsBool: Boolean;
    function IsNull: Boolean;
    function AsObject: IJSONObject;
    function AsArray: IJSONArray;
    function AsString: IJSONString;
    function AsNumber: IJSONNumber;
    function AsBool: IJSONBool;
    function AsNull: IJSONNull;
    function CreateJSONText(Option: TJSONCreateTextOption): string; overload;
    function CreateJSONText: string; overload;
    function CreatePackedJSONText: string;
    procedure BuildJSONText( Option: TJSONCreateTextOption;
      TextBuilder: TJSONTextBuilder);
  end;

  IJSONObject = interface(IJSONValue)
    ['{F0460894-9A61-463D-9C0A-E63690397411}']
    function GetCount: Integer;
    function GetNames(Index: Integer): string;
    function GetValues(Index: Integer): IJSONValue;
    function GetMembers(const Name: string): IJSONValue;
    procedure SetMembers(const Name: string; const AValue: IJSONValue);
    procedure RemoveMember(const Name: string);
    property Names[Index: Integer]: string read GetNames;
    property Values[Index: Integer]: IJSONValue read GetValues;
    property Count: Integer read GetCount;
    property Members[const Name: string]: IJSONValue read GetMembers
      write SetMembers; default;
  end;

  IJSONArray = interface(IJSONValue)
    ['{064F1B3F-75B3-41E0-84D5-959BF92FA777}']
    function GetCount: Integer;
    function GetElements(Index: Integer): IJSONValue;
    procedure SetElements(Index: Integer; const AValue: IJSONValue);
    procedure Add(const AValue: IJSONValue);
    procedure Insert(Index: Integer; const AValue: IJSONValue);
    procedure Remove(const AValue: IJSONValue);
    procedure Delete(Index: Integer);
    property Count: Integer read GetCount;
    property Elements[Index: Integer]: IJSONValue read GetElements
      write SetElements; default;
  end;

  IJSONString = interface(IJSONValue)
    ['{75D7FB17-D2BD-4CFB-BEBA-934D0B14A56D}']
    procedure SetValue(const AValue: string);
    function GetValue: string;
    property Value: string read GetValue write SetValue;
  end;

  IJSONNumber = interface(IJSONValue)
    ['{5B018B3B-87AB-46BD-B2B5-D5DF7C983514}']
    procedure SetFloatValue(const AValue: Extended);
    function GetFloatValue: Extended;
    procedure SetIntValue(AValue: Int64);
    function GetIntValue: Int64;
    function GetIsFloat: Boolean;
    property FloatValue: Extended read GetFloatValue write SetFloatValue;
    property IntValue: Int64 read GetIntValue write SetIntValue;
    property IsFloat: Boolean read GetIsFloat;
  end;

  IJSONBool = interface(IJSONValue)
    ['{C1586812-F0BB-4206-AAD1-D21BDDE4C913}']
    procedure SetValue(AValue: Boolean);
    function GetValue: Boolean;
    property Value: Boolean read GetValue write SetValue;
  end;

  IJSONNull = interface(IJSONValue)
    ['{29F36AB3-674C-482B-B831-58579FA2C957}']
  end;

  TJSONValueFactory = class
  protected
    class function InternalParseJSONValue(AParseContext: TJSONParseContext)
      : IJSONValue; virtual; abstract;
  public
    class function ParseJSONValue(AParseContext: TJSONParseContext): IJSONValue;
  end;

  TJSONBoolFactory = class(TJSONValueFactory)
  protected
    class function InternalParseJSONValue(AParseContext: TJSONParseContext)
      : IJSONValue; override;
  public
    class function CreateValue( b: Boolean): IJSONBool;
  end;

  TJSONNullFactory = class(TJSONValueFactory)
  protected
    class function InternalParseJSONValue(AParseContext: TJSONParseContext)
      : IJSONValue; override;
  public
    class function CreateValue: IJSONNull;
  end;

  TJSONObjectFactory = class(TJSONValueFactory)
  protected
    class function InternalParseJSONValue(AParseContext: TJSONParseContext)
      : IJSONValue; override;
  public
    class function CreateValue: IJSONObject;
  end;

  TJSONArrayFactory = class(TJSONValueFactory)
  protected
    class function InternalParseJSONValue(AParseContext: TJSONParseContext)
      : IJSONValue; override;
  public
    class function CreateValue: IJSONArray;
  end;

  TJSONNumberFactory = class(TJSONValueFactory)
  protected
    class function InternalParseJSONValue(AParseContext: TJSONParseContext)
      : IJSONValue; override;
  public
    class function CreateValue( AIntValue: Int64): IJSONNumber; overload;
    class function CreateValue( AFloatValue: Extended): IJSONNumber; overload;
  end;

  TJSONStringFactory = class(TJSONValueFactory)
  protected
    class function InternalParseJSONValue(AParseContext: TJSONParseContext)
      : IJSONValue; override;
  public
    class function CreateValue( const S: string): IJSONString;
  end;

  TJSONParser = class
  public
    class function ParseJSONText(AParseContext: TJSONParseContext;
      const S: string): IJSONValue; overload;
    class function ParseJSONText(const S: string): IJSONValue; overload;
    class function ParseJSONText(const S: string; out ErrorMsg: string)
      : IJSONValue; overload;
  end;

  TJSONValueFactoryClass = class of TJSONValueFactory;

  TJSONParseContextSavePoint = record
    PrevChar: Char;
    Current: Integer;
    Line: Integer;
    Column: Integer;
  end;

  TJSONParseContext = class
  strict private
  const
    JSONValueFactoryList: array [TJSONValueType] of TJSONValueFactoryClass =
      (TJSONBoolFactory, TJSONNullFactory, TJSONObjectFactory,
      TJSONArrayFactory, TJSONNumberFactory, TJSONStringFactory);

    procedure RestoreContext; inline;
    procedure ReleaseSavePoint; inline;
  private
    FLine: Integer;
    FColumn: Integer;
    FData: string;
    FDataLen: Integer;
    FCurrent: Integer;
    FPrevChar: Char;
    FSavePointsLen: Integer;
    FSavePointCount: Integer;
//    FSavePoints: TArray<TJSONParseContextSavePoint>;
    FSavePoints: array of TJSONParseContextSavePoint;

    function GuessNextValueType(out ValueType: TJSONValueType): Boolean; inline;
    function LookAheadNoWhiteSpace: Char; inline;
    function ExpectStringMoveForward_NOCRLF_NONULL(const S: string)
      : Boolean; inline;
    function IsWhiteSpace(ch: Char): Boolean; inline;
  public
    function GetJSONNull: Boolean; inline;
    function GetJSONBool(out Value: Boolean): Boolean; inline;
    function GetJSONString(out Value: string): Boolean; inline;
    function GetDigitStr(out Value: string): Boolean; inline;
    function LookAhead: Char; inline;
    function GetChar: Char; inline;
    procedure ConsumeWhiteSpaces; inline;
    procedure SaveContext; inline;
    procedure ParseError(const S: string);
    procedure ResolveSavePoint(bSuccess: Boolean); inline;
    function ParseJSONValue(ValueType: TJSONValueType): IJSONValue;
      overload; inline;
    function ParseJSONValue(ValueTypes: TJSONValueTypes): IJSONValue;
      overload; inline;
    function ParseJSONValue: IJSONValue; overload; inline;
    constructor Create(const S: string);
  end;

implementation

var
  JSONFormatSettings: TFormatSettings = (ThousandSeparator: ',';
    DecimalSeparator: '.');

function JSONFloatToStr(Value: Extended): string;
begin
  Result := FloatToStr(Value, JSONFormatSettings);
end;

function JSONTryStrToFloat(const S: string; out Value: Extended): Boolean;
begin
  Result := TryStrToFloat(S, Value, JSONFormatSettings);
end;

function IsHexDigit(ch: Char): Boolean; inline;
begin
  Result := CharInSet(ch, ['A' .. 'F', 'a' .. 'f', '0' .. '9']);
end;

function IsDigit(ch: Char): Boolean; inline;
begin
  Result := CharInSet(ch, ['0' .. '9']);
end;

type
  TJSONValueImpl = class(TInterfacedObject, IJSONValue)
  protected
    function RemoveIndent(const S: string;
      Option: TJSONCreateTextOption): string;

    function IsObject: Boolean; virtual;
    function IsArray: Boolean; virtual;
    function IsString: Boolean; virtual;
    function IsNumber: Boolean; virtual;
    function IsBool: Boolean; virtual;
    function IsNull: Boolean; virtual;
    function AsObject: IJSONObject; virtual;
    function AsArray: IJSONArray; virtual;
    function AsString: IJSONString; virtual;
    function AsNumber: IJSONNumber; virtual;
    function AsBool: IJSONBool; virtual;
    function AsNull: IJSONNull; virtual;
    function CreateJSONText(Option: TJSONCreateTextOption):
      string; overload;
    function CreateJSONText: string; overload;
    function CreatePackedJSONText: string;
    procedure BuildJSONText( Option: TJSONCreateTextOption;
      TextBuilder: TJSONTextBuilder); virtual; abstract;
  end;

  TJSONObjectImpl = class(TJSONValueImpl, IJSONObject)
  private
    FDictionary: TDictionary<string, IJSONValue>;
    FNames: TList<string>;
  protected
    function IsObject: Boolean; override;
    function AsObject: IJSONObject; override;

    function GetCount: Integer;
    function GetNames(Index: Integer): string;
    function GetValues(Index: Integer): IJSONValue;
    function GetMembers(const Name: string): IJSONValue;
    procedure SetMembers(const Name: string; const AValue: IJSONValue);
    procedure RemoveMember(const Name: string);
    property Names[Index: Integer]: string read GetNames;
    property Values[Index: Integer]: IJSONValue read GetValues;
    property Count: Integer read GetCount;
    property Members[const Name: string]: IJSONValue read GetMembers
      write SetMembers; default;
    procedure BuildJSONText( Option: TJSONCreateTextOption;
      TextBuilder: TJSONTextBuilder); override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TJSONArrayImpl = class(TJSONValueImpl, IJSONArray)
  private
    FList: TList<IJSONValue>;
  protected
    function IsArray: Boolean; override;
    function AsArray: IJSONArray; override;

    function GetCount: Integer;
    function GetElements(Index: Integer): IJSONValue;
    procedure SetElements(Index: Integer; const AValue: IJSONValue);
    procedure Add(const AValue: IJSONValue);
    procedure Insert(Index: Integer; const AValue: IJSONValue);
    procedure Remove(const AValue: IJSONValue);
    procedure Delete(Index: Integer);
    property Count: Integer read GetCount;
    property Elements[Index: Integer]: IJSONValue read GetElements
      write SetElements; default;
    procedure BuildJSONText( Option: TJSONCreateTextOption;
      TextBuilder: TJSONTextBuilder); override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TJSONStringImpl = class(TJSONValueImpl, IJSONString)
  private
    FValue: string;
  protected
    function IsString: Boolean; override;
    function AsString: IJSONString; override;

    procedure SetValue(const AValue: string);
    function GetValue: string;
    property Value: string read GetValue write SetValue;
    procedure BuildJSONText( Option: TJSONCreateTextOption;
      TextBuilder: TJSONTextBuilder); override;
  public
    constructor Create(const AValue: string);
  end;

  TJSONNumberImpl = class(TJSONValueImpl, IJSONNumber)
  private
    FFloatValue: Extended;
    FIntValue: Int64;
    FIsFloat: Boolean;
  protected
    function IsNumber: Boolean; override;
    function AsNumber: IJSONNumber; override;

    procedure SetFloatValue(const AValue: Extended);
    function GetFloatValue: Extended;
    procedure SetIntValue(AValue: Int64);
    function GetIntValue: Int64;
    function GetIsFloat: Boolean;
    property FloatValue: Extended read GetFloatValue write SetFloatValue;
    property IntValue: Int64 read GetIntValue write SetIntValue;
    property IsFloat: Boolean read GetIsFloat;

    procedure BuildJSONText( Option: TJSONCreateTextOption;
      TextBuilder: TJSONTextBuilder); override;
  public
    constructor Create(const AFloatValue: Extended); overload;
    constructor Create(const AIntValue: Int64); overload;
  end;

  TJSONBoolImpl = class(TJSONValueImpl, IJSONBool)
  private
    FValue: Boolean;
  protected
    function IsBool: Boolean; override;
    function AsBool: IJSONBool; override;

    procedure SetValue(AValue: Boolean);
    function GetValue: Boolean;
    property Value: Boolean read GetValue write SetValue;

    procedure BuildJSONText( Option: TJSONCreateTextOption;
      TextBuilder: TJSONTextBuilder); override;
  public
    constructor Create(AValue: Boolean);
  end;

  TJSONNullImpl = class(TJSONValueImpl, IJSONNull)
  protected
    function IsNull: Boolean; override;
    function AsNull: IJSONNull; override;

    procedure BuildJSONText( Option: TJSONCreateTextOption;
      TextBuilder: TJSONTextBuilder); override;
  end;


{ TJSONParseContext }

procedure TJSONParseContext.ConsumeWhiteSpaces;
begin
  while IsWhiteSpace(LookAhead) do
    GetChar;
end;

constructor TJSONParseContext.Create(const S: string);
begin
  inherited Create;
  FData := S;
  FDataLen := Length(FData);
end;

function TJSONParseContext.ExpectStringMoveForward_NOCRLF_NONULL
  (const S: string): Boolean;
var
  sLen: Integer;
  Remains: Integer;
begin
  Result := False;
  sLen := Length(S);
  Remains := FDataLen - FCurrent;
  if Remains < sLen then
  begin
    Exit;
  end;

  if Copy(FData, FCurrent + 1, sLen) = S then
  begin
    Result := True;
    FCurrent := FCurrent + sLen;
    FColumn := FColumn + sLen;
  end;
end;

function TJSONParseContext.GetChar: Char;
begin
  if FCurrent >= FDataLen then
  begin
    Result := #0;
    Exit;
  end;

  Inc(FCurrent);
  Result := FData[FCurrent];

  if FLine = 0 then
  begin
    FLine := 1;
  end;

  case FPrevChar of
    #$0A:
      begin
        Inc(FLine);
        FColumn := 0;
      end;
    #$0D:
      if (Result <> #$0A) then
      begin
        Inc(FLine);
        FColumn := 0;
      end;
  end;

  Inc(FColumn);
  FPrevChar := Result;

end;

function TJSONParseContext.GetDigitStr(out Value: string): Boolean;
var
  len: Integer;
  nStart, nPos: Integer;
begin
  Value := '';
  Result := False;
  len := 0;
  nStart := FCurrent + 1;
  nPos := nStart;
  if FDataLen > 0 then
  begin
    while nPos <= FDataLen do
    begin
      if not IsDigit(FData[nPos]) then
      begin
        Break;
      end;
      Inc(nPos);
      Inc(len);
    end;
  end;

  if len > 0 then
  begin
    Result := True;
    SetLength(Value, len);
    System.Move(FData[nStart], Value[1], len * SizeOf(Char));
    Inc(FCurrent, len);
    Inc(FColumn, len);
  end;
end;

function TJSONParseContext.GetJSONBool(out Value: Boolean): Boolean;
begin
  if ExpectStringMoveForward_NOCRLF_NONULL('false') then
  begin
    Value := False;
    Result := True;
  end else
  if ExpectStringMoveForward_NOCRLF_NONULL('true') then
  begin
    Value := True;
    Result := True;
  end else
  begin
    Value := False;
    Result := False;
  end;
end;

function TJSONParseContext.GetJSONNull: Boolean;
begin
  Result := ExpectStringMoveForward_NOCRLF_NONULL('null');
end;

function TJSONParseContext.GetJSONString(out Value: string): Boolean;
var
  ch, ch2 : Char;
  ch3, ch4, ch5, ch6: Char;
  S, tmp_unichar: string;
  nPos: Integer;
  nCapacity: Integer;
  n: Integer;
  bEndQuotationMarkFound: Boolean;

begin
  tmp_unichar := '';
  Result := False;

  if LookAhead = '"' then
  begin
    GetChar;
  end else
  begin
    Exit;
  end;

  S := '';
  nPos := 0;
  nCapacity := 0;
  bEndQuotationMarkFound := False;
  while True do
  begin
    ch := GetChar;
    case ch of
      #$00 :
        Break;
      #$01..#$19 :
        ParseError( 'Invalid charactor for JSON string: #' + IntToHex( Integer(ch), 2 ));
      '"':
        begin
          bEndQuotationMarkFound := True;
          Break;
        end;
      '\':
        begin
          ch2 := GetChar;
          case ch2 of
            '"', '\', '/':
              ch := ch2;
            'b':
              ch := #$0008;
            'f':
              ch := #$000C;
            'n':
              ch := #$000A;
            'r':
              ch := #$000D;
            't':
              ch := #$0009;
            'u':
              begin
                ch3 := GetChar;
                if not IsHexDigit(ch3) then
                  Exit;
                ch4 := GetChar;
                if not IsHexDigit(ch4) then
                  Exit;
                ch5 := GetChar;
                if not IsHexDigit(ch5) then
                  Exit;
                ch6 := GetChar;
                if not IsHexDigit(ch6) then
                  Exit;

                if tmp_unichar = '' then
                begin
                  SetLength(tmp_unichar, 5);
                  tmp_unichar[1] := '$';
                end;

                tmp_unichar[2] := ch3;
                tmp_unichar[3] := ch4;
                tmp_unichar[4] := ch5;
                tmp_unichar[5] := ch6;

                if not TryStrToInt(tmp_unichar, n) then
                begin
                  ParseError( 'Cannot convert hexdit to char: ' + tmp_unichar );
                end;
                ch := Char(n);
              end;
          end;
        end
    end;

    Inc(nPos);
    if nPos > nCapacity then
    begin
      if nCapacity <= 0 then
      begin
        nCapacity := 16;
      end else
      begin
        nCapacity := nCapacity * 2;
      end;
      SetLength(S, nCapacity);
    end;
    S[nPos] := ch;
  end;

  if not bEndQuotationMarkFound then
  begin
    ParseError( 'End quotation mark not found' );
  end;

  Value := '';
  if nPos > 0 then
  begin
    SetLength(Value, nPos);
    System.Move(S[1], Value[1], nPos * SizeOf(Char));
  end;

  Result := True;
end;

function TJSONParseContext.GuessNextValueType(out ValueType
  : TJSONValueType): Boolean;
begin
  Result := False;
  case LookAheadNoWhiteSpace of
    '"':
      begin
        ValueType := jvtString;
        Result := True;
      end;
    '-', '0' .. '9':
      begin
        ValueType := jvtNumber;
        Result := True;
      end;
    '[':
      begin
        ValueType := jvtArray;
        Result := True;
      end;
    '{':
      begin
        ValueType := jvtObject;
        Result := True;
      end;
    't', 'f':
      begin
        ValueType := jvtBool;
        Result := True;
      end;
    'n':
      begin
        ValueType := jvtNull;
        Result := True;
      end;
  end;
end;

function TJSONParseContext.IsWhiteSpace(ch: Char): Boolean;
begin
  Result := CharInSet(ch, [#$20, #$09, #$0A, #$0D]);
end;

function TJSONParseContext.LookAhead: Char;
begin
  Result := #0;
  if (FDataLen > 0) and (FCurrent < FDataLen) then
  begin
    Result := FData[FCurrent + 1];
  end;
end;

function TJSONParseContext.LookAheadNoWhiteSpace: Char;
var
  nPos: Integer;
  ch: Char;
begin
  Result := #0;
  if FDataLen > 0 then
  begin
    nPos := FCurrent + 1;
    while True do
    begin
      if nPos > FDataLen then
      begin
        Exit;
      end;
      ch := FData[nPos];
      if not IsWhiteSpace(ch) then
      begin
        Result := ch;
        Exit;
      end;
      Inc(nPos);
    end;
  end;
end;

procedure TJSONParseContext.ParseError(const S: string);
begin
  raise EJsonParseError.Create(Format('Error at line %d column %d: %s',
    [FLine, FColumn, S]));
end;

function TJSONParseContext.ParseJSONValue(ValueType: TJSONValueType): IJSONValue;
begin
  Result := JSONValueFactoryList[ValueType].ParseJSONValue(Self);
end;

function TJSONParseContext.ParseJSONValue(ValueTypes: TJSONValueTypes): IJSONValue;
var
  Guess: TJSONValueType;
begin
  Result := nil;
  if GuessNextValueType(Guess) then
  begin
    if Guess in ValueTypes then
      Result := ParseJSONValue(Guess);
  end;
end;

function TJSONParseContext.ParseJSONValue: IJSONValue;
begin
  Result := ParseJSONValue([jvtBool, jvtNull, jvtObject, jvtArray, jvtNumber,
    jvtString]);
end;

procedure TJSONParseContext.ReleaseSavePoint;
begin
  if FSavePointCount > 0 then
  begin
    Dec(FSavePointCount);
  end;
end;

procedure TJSONParseContext.ResolveSavePoint(bSuccess: Boolean);
begin
  if bSuccess then
  begin
    ReleaseSavePoint;
  end else
  begin
    RestoreContext;
  end;
end;

procedure TJSONParseContext.RestoreContext;
begin
  if FSavePointCount > 0 then
  begin
    with FSavePoints[FSavePointCount - 1] do
    begin
      FPrevChar := PrevChar;
      FCurrent := Current;
      FLine := Line;
      FColumn := Column;
    end;
    Dec(FSavePointCount);
  end;
end;

procedure TJSONParseContext.SaveContext;
begin
  if FSavePointsLen <= FSavePointCount then
  begin
    if FSavePointsLen <= 0 then
    begin
      FSavePointsLen := 16;
    end else
    begin
      FSavePointsLen := FSavePointsLen * 2;
    end;
    SetLength(FSavePoints, FSavePointsLen);
  end;
  Inc(FSavePointCount);
  with FSavePoints[FSavePointCount - 1] do
  begin
    PrevChar := FPrevChar;
    Current := FCurrent;
    Line := FLine;
    Column := FColumn;
  end;
end;

{ TJSONValueImpl }

function TJSONValueImpl.AsArray: IJSONArray;
begin
  Result := nil;
end;

function TJSONValueImpl.AsBool: IJSONBool;
begin
  Result := nil;
end;

function TJSONValueImpl.AsNull: IJSONNull;
begin
  Result := nil;
end;

function TJSONValueImpl.AsNumber: IJSONNumber;
begin
  Result := nil;
end;

function TJSONValueImpl.AsObject: IJSONObject;
begin
  Result := nil;
end;

function TJSONValueImpl.AsString: IJSONString;
begin
  Result := nil;
end;

function TJSONValueImpl.CreateJSONText( Option: TJSONCreateTextOption): string;
var
  TextBuilder : TJSONTextBuilder;
begin
  TextBuilder := TJSONTextBuilder.Create( Option );
  try
    BuildJSONText( Option, TextBuilder );
    Result := TextBuilder.GetText;
  finally
    TextBuilder.Free;
  end;
end;

function TJSONValueImpl.CreateJSONText: string;
var
  Option: TJSONCreateTextOption;
begin
  Option := TJSONCreateTextOption.Create;
  try
    Result := CreateJSONText(Option);
  finally
    Option.Free;
  end;
end;

function TJSONValueImpl.CreatePackedJSONText: string;
var
  Option : TJSONCreateTextOption;
begin
  Result := '';
  Option := TJSONCreateTextOption.Create;
  try
    Option.NoIndent := True;
    Option.NoLineBreak := True;
    Option.SpaceAfterNameSeparator := False;
    Option.PackedArray := True;
    Option.PackedObject := True;
    Result :=  CreateJSONText( Option )
  finally
    Option.Free;
  end;
end;

function TJSONValueImpl.IsArray: Boolean;
begin
  Result := False;
end;

function TJSONValueImpl.IsBool: Boolean;
begin
  Result := False;
end;

function TJSONValueImpl.IsNull: Boolean;
begin
  Result := False;
end;

function TJSONValueImpl.IsNumber: Boolean;
begin
  Result := False;
end;

function TJSONValueImpl.IsObject: Boolean;
begin
  Result := False;
end;

function TJSONValueImpl.IsString: Boolean;
begin
  Result := False;
end;

function TJSONValueImpl.RemoveIndent(const S: string;
  Option: TJSONCreateTextOption): string;
var
  IndentStrLen: Integer;
  nIndent: Integer;
begin
  Result := S;
  IndentStrLen := Length(Option.IndentString);
  if IndentStrLen > 0 then
  begin
    nIndent := 0;
    while (Copy(Result, nIndent * IndentStrLen + 1, IndentStrLen)
      = Option.IndentString) do
      Inc(nIndent);
    System.Delete(Result, 1, nIndent * IndentStrLen);
  end;
end;

//class function TJSONValueImpl.StringText(const S: string;
//  Option: TJSONCreateTextOption): string;
//var
//  sb: TStringBuilder;
//  i: Integer;
//  ch: Char;
//  len : Integer;
//begin
//  Result := '';
//
//  len := 0;
//  for i := 1 to Length(S) do
//  begin
//    ch := S[i];
//    if Option.EscapeUnicodeChar then
//    begin
//      if ch > #$7E then
//      begin
//        Inc( len, 6 );
//        Continue;
//      end;
//    end;
//    case ch of
//      '"',
//      '\',
//      #$0008,
//      #$000C,
//      #$000A,
//      #$000D,
//      #$0009 : Inc( len, 2);
//      '/': begin
//        if Option.EscapeSlash then
//        begin
//          Inc( len, 2);
//        end else
//        begin
//          Inc( len, 1);
//        end;
//      end
//      else
//        Inc( len, 1);
//      end;
//  end;
//
//  if len <= 0 then
//  begin
//    Exit;
//  end;
//
//  SetLength( Result, len );
//
//    for i := 1 to Length(S) do
//    begin
//      ch := S[i];
//      if Option.EscapeUnicodeChar then
//      begin
//        if ch > #$7E then
//        begin
//          sb.Append('\u' + LowerCase( IntToHex(Integer(ch), 4)));
//          Continue;
//        end;
//      end;
//      case ch of
//        '"':
//          sb.Append('\"');
//        '\':
//          sb.Append('\\');
//        '/': begin
//          if Option.EscapeSlash then
//          begin
//            sb.Append('\/');
//          end else
//          begin
//            sb.Append('/');
//          end;
//        end;
//        #$0008:
//          sb.Append('\b');
//        #$000C:
//          sb.Append('\f');
//        #$000A:
//          sb.Append('\n');
//        #$000D:
//          sb.Append('\r');
//        #$0009:
//          sb.Append('\t');
//      else
//        sb.Append(ch);
//      end;
//    end;
//    sb.Append('"');
//    Result := sb.ToString;
//  finally
//    sb.Free;
//  end;
//
//
////  sb := TStringBuilder.Create;
////  try
////    sb.Append('"');
////    for i := 1 to Length(S) do
////    begin
////      ch := S[i];
////      if Option.EscapeUnicodeChar then
////      begin
////        if ch > #$7E then
////        begin
////          sb.Append('\u' + LowerCase( IntToHex(Integer(ch), 4)));
////          Continue;
////        end;
////      end;
////      case ch of
////        '"':
////          sb.Append('\"');
////        '\':
////          sb.Append('\\');
////        '/': begin
////          if Option.EscapeSlash then
////          begin
////            sb.Append('\/');
////          end else
////          begin
////            sb.Append('/');
////          end;
////        end;
////        #$0008:
////          sb.Append('\b');
////        #$000C:
////          sb.Append('\f');
////        #$000A:
////          sb.Append('\n');
////        #$000D:
////          sb.Append('\r');
////        #$0009:
////          sb.Append('\t');
////      else
////        sb.Append(ch);
////      end;
////    end;
////    sb.Append('"');
////    Result := sb.ToString;
////  finally
////    sb.Free;
////  end;
//end;

{ TJSONObjectImpl }

function TJSONObjectImpl.AsObject: IJSONObject;
begin
  Result := Self;
end;

procedure TJSONObjectImpl.BuildJSONText( Option: TJSONCreateTextOption;
  TextBuilder: TJSONTextBuilder);
var
//  sb: TStringBuilder;
  i: Integer;
  nm: string;
  Value: IJSONValue;

begin
  TextBuilder.Write('{');
  if not Option.PackedObject then
  begin
    TextBuilder.WriteLineBreak;
  end;

  TextBuilder.IncrIndent;
  try
    for i := 0 to Count - 1 do
    begin
      nm := Names[i];
      Value := Members[nm];
      TextBuilder.WriteJSONString( nm );
      TextBuilder.WriteNameSeparator;
      Value.BuildJSONText( Option, TextBuilder );
      if i < (Count - 1) then
      begin
        TextBuilder.WriteValueSeparator;
      end;
      if not Option.PackedObject then
      begin
        TextBuilder.WriteLineBreak;
      end;
    end;
  finally
    TextBuilder.DecrIndent;
  end;

  TextBuilder.Write('}', True);
end;

constructor TJSONObjectImpl.Create;
begin
  inherited;
  FNames := TList<string>.Create;
  FDictionary := TDictionary<string, IJSONValue>.Create;
end;

//function TJSONObjectImpl.CreateJSONText(
//  Option: TJSONCreateTextOption): string;
//var
//  sb: TStringBuilder;
//  i: Integer;
//  nm: string;
//  Value: IJSONValue;
//
//begin
//  sb := TStringBuilder.Create;
//  try
//    sb.Append(DupeString(Option.IndentString, Indent));
//    sb.Append('{');
//    if Count > 0 then
//    begin
//      sb.Append(Option.LineBreak);
//      Inc(Indent);
//      try
//        for i := 0 to Count - 1 do
//        begin
//          nm := Names[i];
//          Value := Members[nm];
//          sb.Append(DupeString(Option.IndentString, Indent));
//          sb.Append(StringText(nm, Option));
//          sb.Append(': ');
//          sb.Append(RemoveIndent(Value.CreateJSONText(Indent, Option), Option));
//          if i < (Count - 1) then
//          begin
//            sb.Append(',');
//          end;
//          sb.Append(Option.LineBreak);
//        end;
//      finally
//        Dec(Indent);
//      end;
//    end;
//    sb.Append(DupeString(Option.IndentString, Indent));
//    sb.Append('}');
//    Result := sb.ToString;
//  finally
//    sb.Free;
//  end;
//end;

destructor TJSONObjectImpl.Destroy;
begin
  FDictionary.Free;
  FNames.Free;
  inherited;
end;

function TJSONObjectImpl.GetCount: Integer;
begin
  Result := FNames.Count;
end;

function TJSONObjectImpl.GetMembers(const Name: string): IJSONValue;
begin
  FDictionary.TryGetValue(Name, Result);
end;

function TJSONObjectImpl.GetNames(Index: Integer): string;
begin
  Result := FNames[Index];
end;

function TJSONObjectImpl.GetValues(Index: Integer): IJSONValue;
begin
  Result := Members[FNames[Index]];
end;

function TJSONObjectImpl.IsObject: Boolean;
begin
  Result := True;
end;

procedure TJSONObjectImpl.RemoveMember(const Name: string);
begin
  FDictionary.Remove(Name)
end;

procedure TJSONObjectImpl.SetMembers(const Name: string;
  const AValue: IJSONValue);
begin
  if Name = '' then
    Exit;
  if AValue = nil then
  begin
    if FDictionary.ContainsKey(Name) then
    begin
      FNames.Remove(Name);
      FDictionary.Remove(Name);
    end;
  end else
  begin
    if not FDictionary.ContainsKey(Name) then
    begin
      FNames.Add(Name);
    end;
    FDictionary.AddOrSetValue(Name, AValue);
  end;
end;

{ TJSONArrayImpl }

procedure TJSONArrayImpl.Add(const AValue: IJSONValue);
begin
  FList.Add(AValue);
end;

function TJSONArrayImpl.AsArray: IJSONArray;
begin
  Result := Self;
end;

procedure TJSONArrayImpl.BuildJSONText(Option: TJSONCreateTextOption;
  TextBuilder: TJSONTextBuilder);
var
  i: Integer;
  Value: IJSONValue;

begin
  TextBuilder.Write( '[' );

  if not Option.PackedArray then
  begin
    TextBuilder.WriteLineBreak;
  end;

  TextBuilder.IncrIndent;
  try
    for i := 0 to FList.Count - 1 do
    begin
      Value := FList[i];
      Value.BuildJSONText( Option, TextBuilder);
      if i < (FList.Count - 1) then
      begin
        TextBuilder.WriteValueSeparator;
      end;

      if not Option.PackedArray then
      begin
        TextBuilder.WriteLineBreak;
      end;
    end;

  finally
    TextBuilder.DecrIndent;
  end;

  TextBuilder.Write( ']', True);
end;

constructor TJSONArrayImpl.Create;
begin
  inherited Create;
  FList := TList<IJSONValue>.Create;
end;

procedure TJSONArrayImpl.Delete(Index: Integer);
begin
  FList.Delete(Index);
end;

destructor TJSONArrayImpl.Destroy;
begin
  FList.Free;
  inherited;
end;

function TJSONArrayImpl.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TJSONArrayImpl.GetElements(Index: Integer): IJSONValue;
begin
  Result := FList[Index];
end;

procedure TJSONArrayImpl.Insert(Index: Integer; const AValue: IJSONValue);
begin
  FList.Insert(Index, AValue);
end;

function TJSONArrayImpl.IsArray: Boolean;
begin
  Result := True;
end;

procedure TJSONArrayImpl.Remove(const AValue: IJSONValue);
begin
  FList.Remove(AValue);
end;

procedure TJSONArrayImpl.SetElements(Index: Integer; const AValue: IJSONValue);
begin
  FList[Index] := AValue;
end;

{ TJSONStringImpl }

function TJSONStringImpl.AsString: IJSONString;
begin
  Result := Self;
end;

procedure TJSONStringImpl.BuildJSONText(Option: TJSONCreateTextOption;
  TextBuilder: TJSONTextBuilder);
begin
  TextBuilder.WriteJSONString( FValue);
end;

constructor TJSONStringImpl.Create(const AValue: string);
begin
  inherited Create;
  FValue := AValue;
end;

function TJSONStringImpl.GetValue: string;
begin
  Result := FValue;
end;

function TJSONStringImpl.IsString: Boolean;
begin
  Result := True;
end;

procedure TJSONStringImpl.SetValue(const AValue: string);
begin
  FValue := AValue;
end;

{ TJSONNumberImpl }

function TJSONNumberImpl.AsNumber: IJSONNumber;
begin
  Result := Self;
end;

constructor TJSONNumberImpl.Create(const AFloatValue: Extended);
begin
  inherited Create;
  SetFloatValue(AFloatValue);
end;

procedure TJSONNumberImpl.BuildJSONText(Option: TJSONCreateTextOption;
  TextBuilder: TJSONTextBuilder);
  function SelectNumberText: string;
  begin
    if FIsFloat then
    begin
      Result := JSONFloatToStr(FFloatValue);
    end
    else
    begin
      Result := IntToStr(FIntValue);
    end;
  end;
begin
  TextBuilder.Write( SelectNumberText);
end;

constructor TJSONNumberImpl.Create(const AIntValue: Int64);
begin
  inherited Create;
  SetIntValue(AIntValue);
end;

function TJSONNumberImpl.GetFloatValue: Extended;
begin
  if FIsFloat then
  begin
    Result := FFloatValue;
  end else
  begin
    Result := FIntValue;
  end;
end;

function TJSONNumberImpl.GetIntValue: Int64;
begin
  if FIsFloat then
  begin
    Result := Trunc(FFloatValue);
  end else
  begin
    Result := FIntValue;
  end;
end;

function TJSONNumberImpl.GetIsFloat: Boolean;
begin
  Result := FIsFloat;
end;

function TJSONNumberImpl.IsNumber: Boolean;
begin
  Result := True;
end;

procedure TJSONNumberImpl.SetFloatValue(const AValue: Extended);
begin
  FFloatValue := AValue;
  FIsFloat := True;
end;

procedure TJSONNumberImpl.SetIntValue(AValue: Int64);
begin
  FIntValue := AValue;
  FIsFloat := False;
end;

{ TJSONBoolImpl }

function TJSONBoolImpl.AsBool: IJSONBool;
begin
  Result := Self;
end;

procedure TJSONBoolImpl.BuildJSONText(Option: TJSONCreateTextOption;
  TextBuilder: TJSONTextBuilder);
var
  S: string;
begin
  if FValue then
  begin
    S := 'true';
  end
  else
  begin
    S := 'false';
  end;

  TextBuilder.Write( S );
end;

constructor TJSONBoolImpl.Create(AValue: Boolean);
begin
  inherited Create;
  FValue := AValue;
end;

function TJSONBoolImpl.GetValue: Boolean;
begin
  Result := FValue;
end;

function TJSONBoolImpl.IsBool: Boolean;
begin
  Result := True;
end;

procedure TJSONBoolImpl.SetValue(AValue: Boolean);
begin
  FValue := AValue;
end;

{ TJSONNullImpl }

function TJSONNullImpl.AsNull: IJSONNull;
begin
  Result := Self;
end;

procedure TJSONNullImpl.BuildJSONText(Option: TJSONCreateTextOption;
  TextBuilder: TJSONTextBuilder);
begin
  TextBuilder.Write( 'null' );
end;

function TJSONNullImpl.IsNull: Boolean;
begin
  Result := True;
end;

{ TJSONBoolFactory }

class function TJSONBoolFactory.CreateValue(b: Boolean): IJSONBool;
begin
  Result := TJSONBoolImpl.Create( b );
end;

class function TJSONBoolFactory.InternalParseJSONValue(AParseContext
  : TJSONParseContext): IJSONValue;
var
  b: Boolean;
begin
  Result := nil;

  if AParseContext.GetJSONBool(b) then
  begin
    Result := TJSONBoolImpl.Create(b);
  end;
end;

{ TJSONValueFactory }

class function TJSONValueFactory.ParseJSONValue(AParseContext: TJSONParseContext)
  : IJSONValue;
begin
  AParseContext.SaveContext;
  try
    Result := InternalParseJSONValue(AParseContext);
  finally
    AParseContext.ResolveSavePoint(Result <> nil);
  end;
end;

{ TJSONNullFactory }

class function TJSONNullFactory.CreateValue: IJSONNull;
begin
  Result := TJSONNullImpl.Create;
end;

class function TJSONNullFactory.InternalParseJSONValue(AParseContext
  : TJSONParseContext): IJSONValue;
begin
  Result := nil;
  if AParseContext.GetJSONNull then
  begin
    Result := TJSONNullImpl.Create;
  end;
end;

{ TJSONObjectFactory }

class function TJSONObjectFactory.CreateValue: IJSONObject;
begin
  Result := TJSONObjectImpl.Create;
end;

class function TJSONObjectFactory.InternalParseJSONValue(AParseContext
  : TJSONParseContext): IJSONValue;
var
  name: string;
  Value: IJSONValue;
  obj: IJSONObject;
  bFirst: Boolean;
begin
  Result := nil;

  AParseContext.ConsumeWhiteSpaces;
  if AParseContext.GetChar = '{' then
  begin
    AParseContext.ConsumeWhiteSpaces;
  end else
  begin
    Exit;
  end;

  obj := TJSONObjectImpl.Create;

  bFirst := True;
  while True do
  begin

    if not bFirst then
    begin
      if AParseContext.LookAhead = ',' then
      begin
        AParseContext.GetChar;
        AParseContext.ConsumeWhiteSpaces;
      end else
      begin
        Break;
      end;
    end;

    name := '';
    if not AParseContext.GetJSONString(name) then
    begin
      if bFirst then
      begin
        Break;
      end else
      begin
        AParseContext.ParseError('Expecting field name(string).');
      end;
    end;

    AParseContext.ConsumeWhiteSpaces;

    if AParseContext.GetChar = ':' then
    begin
      AParseContext.ConsumeWhiteSpaces;
    end else
    begin
      AParseContext.ParseError('Expecting name-separator(":").');
    end;

    Value := AParseContext.ParseJSONValue;
    if Value = nil then
    begin
      AParseContext.ParseError
        ('Expecting value(false / null / true / object / array / number / string).');
    end;

    AParseContext.ConsumeWhiteSpaces;

    obj[name] := Value;
    bFirst := False;
  end;

  if AParseContext.GetChar = '}' then
  begin
    AParseContext.ConsumeWhiteSpaces;
    Result := obj;
  end else
  begin
    if bFirst then
    begin
      AParseContext.ParseError('Expecting field name(string) or end-object("}").');
    end else
    begin
      AParseContext.ParseError('Expecting value-sep(",") or end-object("}").');
    end;
  end;
end;

{ TJSONArrayFactory }

class function TJSONArrayFactory.CreateValue: IJSONArray;
begin
  Result := TJSONArrayImpl.Create;
end;

class function TJSONArrayFactory.InternalParseJSONValue(AParseContext
  : TJSONParseContext): IJSONValue;
var
  Value: IJSONValue;
  bFirst: Boolean;
  a: IJSONArray;
begin
  Result := nil;

  AParseContext.ConsumeWhiteSpaces;
  if AParseContext.GetChar = '[' then
  begin
    AParseContext.ConsumeWhiteSpaces;
  end else
  begin
    Exit;
  end;

  a := TJSONArrayImpl.Create;

  bFirst := True;
  while True do
  begin
    if not bFirst then
    begin
      if AParseContext.LookAhead = ',' then
      begin
        AParseContext.GetChar;
        AParseContext.ConsumeWhiteSpaces;
      end else
      begin
        Break;
      end;
    end;

    Value := AParseContext.ParseJSONValue;

    if Value = nil then
    begin
      if bFirst then
      begin
        Break;
      end else
      begin
        AParseContext.ParseError
          ('Expecting value(false/null/true/object/array/number/string).');
      end;
    end;

    AParseContext.ConsumeWhiteSpaces;

    a.Add(Value);
    bFirst := False;
  end;

  if AParseContext.GetChar = ']' then
  begin
    Result := a;
    AParseContext.ConsumeWhiteSpaces;
  end else
  begin
    if bFirst then
    begin
      AParseContext.ParseError('Expecting value(false/null/true/object/array/number/string) or end-array("]").');
    end else
    begin
      AParseContext.ParseError('Expecting value-sep(",") or end-array("]").');
    end;
  end;
end;

class function TJSONNumberFactory.CreateValue(AIntValue: Int64): IJSONNumber;
begin
  Result := TJSONNumberImpl.Create( AIntValue );
end;

class function TJSONNumberFactory.CreateValue(
  AFloatValue: Extended): IJSONNumber;
begin
  Result := TJSONNumberImpl.Create( AFloatValue );
end;

class function TJSONNumberFactory.InternalParseJSONValue(AParseContext
  : TJSONParseContext): IJSONValue;
var
  s_minus: string;
  s_int: string;
  s_frac: string;
  s_exp: string;
  s_exp_sign: string;
  s_exp_digit: string;
  ch: Char;
  S: string;
  FloatValue: Extended;
  IntValue: Int64;
begin
  Result := nil;

  s_minus := '';
  if AParseContext.LookAhead = '-' then
  begin
    AParseContext.GetChar;
    s_minus := '-';
  end;

  if AParseContext.LookAhead = '0' then
  begin
    AParseContext.GetChar;
    s_int := '0';
  end else
  begin
    s_int := '';
    if not AParseContext.GetDigitStr(s_int) then
    begin
      if s_minus <> '' then
      begin
        AParseContext.ParseError('Expecting number.');
      end;
    end;
  end;

  if s_int = '' then
  begin
    Exit;
  end;

  s_frac := '';
  if AParseContext.LookAhead = '.' then
  begin
    AParseContext.GetChar;
    s_frac := '';
    AParseContext.GetDigitStr(s_frac);

    if s_frac = '' then
    begin
      AParseContext.ParseError('Expecting fraction.');
    end;

    s_frac := '.' + s_frac;
  end;

  s_exp := '';

  if CharInSet(AParseContext.LookAhead, ['e', 'E']) then
  begin
    AParseContext.GetChar;
    s_exp_sign := '';
    ch := AParseContext.LookAhead;
    if CharInSet(ch, ['-', '+']) then
    begin
      AParseContext.GetChar;
      s_exp_sign := ch;
    end;

    s_exp_digit := '';
    AParseContext.GetDigitStr(s_exp_digit);

    if s_exp_digit = '' then
    begin
      AParseContext.ParseError('Expecting exponent digit');
    end;

    s_exp := 'e' + s_exp_sign + s_exp_digit;
  end;

  if (s_frac = '') and (s_exp = '') then
  begin
    S := s_minus + s_int;
    if TryStrToInt64(S, IntValue) then
    begin
      Result := TJSONNumberImpl.Create(IntValue);
    end else
    begin
      AParseContext.ParseError(Format('Cannot convert "%s" to number.', [S]));
    end;
  end else
  begin
    S := s_minus + s_int + s_frac + s_exp;
    if JSONTryStrToFloat(S, FloatValue) then
    begin
      Result := TJSONNumberImpl.Create(FloatValue);
    end else
    begin
      AParseContext.ParseError(Format('Cannot convert "%s" to number.', [S]));
    end;
  end;
end;

{ TJSONStringFactory }

class function TJSONStringFactory.CreateValue(const S: string): IJSONString;
begin
  Result := TJSONStringImpl.Create( S );
end;

class function TJSONStringFactory.InternalParseJSONValue(AParseContext
  : TJSONParseContext): IJSONValue;
var
  S: string;
begin
  Result := nil;
  S := '';
  if AParseContext.GetJSONString(S) then
  begin
    Result := TJSONStringImpl.Create(S);
  end;
end;

{ TJSONParser }

class function TJSONParser.ParseJSONText(const S: string): IJSONValue;
var
  Context: TJSONParseContext;
begin
  Context := TJSONParseContext.Create(S);
  try
    Result := ParseJSONText( Context, S);
  finally
    Context.Free;
  end;
end;

class function TJSONParser.ParseJSONText(AParseContext: TJSONParseContext;
  const S: string): IJSONValue;
begin
  Result := AParseContext.ParseJSONValue([jvtObject, jvtArray]);

  if Result = nil then
  begin
    AParseContext.ParseError('Parse Error. Cannot parse text.');
  end else
  begin
    if AParseContext.LookAheadNoWhiteSpace <> #0 then
    begin
      AParseContext.ParseError('Parse Error. There is an unnecessary charactor after JSON text.');
    end;
  end;
end;

class function TJSONParser.ParseJSONText(const S: string; out ErrorMsg: string)
  : IJSONValue;
begin
  ErrorMsg := '';
  try
    Result := ParseJSONText(S);
  except
    on E: Exception do
    begin
      ErrorMsg := E.Message;
    end;
  end;
end;

{ TJSONCreateTextOption }

constructor TJSONCreateTextOption.Create;
begin
  inherited;
  FIndentString := #$20#$20#$20#$20;
  FLineBreak := #$0D#$0A;
  FSpaceAfterNameSeparator := True;
  FEscapeSlash := True;
end;

{ TJSONTextBuilder }

constructor TJSONTextBuilder.Create(AOption: TJSONCreateTextOption;
  AStartIndent: Integer);
begin
  inherited Create;
  FOption := AOption;
  FIndent := AStartIndent;
end;

procedure TJSONTextBuilder.DecrIndent;
begin
  Dec(FIndent);
end;

function TJSONTextBuilder.GetText: string;
begin
  Result := '';
  if FSize  > 0 then
  begin
    SetLength(Result, FSize);
    System.Move( FBuffer[1], Result[1], FSize * SizeOf(Char) );
  end;
end;

procedure TJSONTextBuilder.IncrIndent;
begin
  Inc(FIndent);
end;

procedure TJSONTextBuilder.InternalWrite(const S: string);
var
  sLen: Integer;
begin
  sLen := Length(S);
  if sLen <= 0 then
  begin
    Exit;
  end;
  InternalWriteBuffer( Pointer(S)^, sLen );
end;

procedure TJSONTextBuilder.InternalWrite(const ch: Char);
begin
  InternalWriteBuffer( ch, 1 );
end;

procedure TJSONTextBuilder.InternalWriteBuffer(const buf; len: Integer);
var
  NewSize: Integer;
  NewCapacity: Integer;
begin
  NewSize := FSize + len;
  NewCapacity := FCapacity;

  while NewCapacity < NewSize do
  begin
    if NewCapacity <= 0 then
    begin
      NewCapacity := 256;
    end else
    begin
      NewCapacity := NewCapacity * 2;
    end;
  end;

  if NewCapacity > FCapacity then
  begin
    FCapacity := NewCapacity;
    SetLength(FBuffer, FCapacity);
  end;

  System.Move(buf, FBuffer[FSize + 1], len * SizeOf(Char));
  FSize := NewSize;
end;

procedure TJSONTextBuilder.PrepareWrite( NoAutoLineBreak: Boolean );
begin
  if not NoAutoLineBreak then
  begin
    if (FOption.LineLengthThreshold > 0 ) and
      (FLineLength > FOption.LineLengthThreshold) then
    begin
      WriteLineBreak;
    end;
  end;

  if FNewLine then
  begin
    if FIndent > 0 then
    begin
      if not FOption.NoIndent then
      begin
        InternalWrite(DupeString(FOption.IndentString, FIndent));
      end;
    end;
  end;
end;

procedure TJSONTextBuilder.Write(const S: string; NoAutoLineBreak: Boolean);
begin
  PrepareWrite( NoAutoLineBreak );
  InternalWrite(S);
  Inc( FLineLength, Length(S));
  FNewLine := False;
end;

procedure TJSONTextBuilder.Write(ch: Char; NoAutoLineBreak: Boolean);
begin
  PrepareWrite( NoAutoLineBreak );
  InternalWrite(ch);
  Inc( FLineLength, 1);
  FNewLine := False;
end;

procedure TJSONTextBuilder.WriteJSONString(const S: string);
var
  i : Integer;
  ch : Char;

begin
  Write('"');
  for i := 1 to Length(S) do
  begin
    ch := S[i];
    if FOption.EscapeUnicodeChar then
    begin
      if ch > #$7E then
      begin
        Write('\u' + LowerCase( IntToHex(Integer(ch), 4)));
        Continue;
      end;
    end;
    case ch of
      '"':
        Write('\"');
      '\':
        Write('\\');
      '/': begin
        if FOption.EscapeSlash then
        begin
          Write('\/');
        end else
        begin
          Write('/');
        end;
      end;
      #$0008:
        Write('\b');
      #$000C:
        Write('\f');
      #$000A:
        Write('\n');
      #$000D:
        Write('\r');
      #$0009:
        Write('\t');
    else
      Write(ch);
    end;
  end;
  Write('"');
end;

procedure TJSONTextBuilder.WriteLineBreak;
begin
  if not FNewLine then
  begin
    if (not FOption.NoLineBreak) and (FOption.LineBreak <> '') then
    begin
      InternalWrite(FOption.LineBreak);
      FNewLine := True;
      FLineLength := 0;
    end;
  end;
end;

procedure TJSONTextBuilder.WriteNameSeparator;
begin
  if FOption.SpaceAfterNameSeparator then
  begin
    Write( ': ', True);
  end else
  begin
    Write( ':', True);
  end;
end;

procedure TJSONTextBuilder.WriteValueSeparator;
begin
  if FOption.SpaceAfterValueSeparator then
  begin
    Write( ', ', True);
  end else
  begin
    Write( ',', True);
  end;
end;

end.

